/* REXX _zonedeploy.zrx by the reverend (build 82)                            */
/*-       built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:19        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* rev. 0 - initial release                                                   */
/* rev. 1 - clears voids surrounding first                                    */

call zoctimeout 60
call zocsynctime 500
globals=_setglobals()
call on halt name _halt

if \_pcheck("Command [") then call _error "please start at the command prompt."

/* ask questions */
if arg(1)="" then do
 figs=_askint("how many figs to deploy?",1,"c")
 if figs=0 then call _quit "script cancelled by user."
 type=left(_chooselist("what type of figs","Toll;Defensive;Offensive",";","c"),1)
 armds=_askint("how many mines to deploy?",0,"c")
 limps=_askint("how many limpets to deploy?",0,"c")
 owc=1
end /*if*/
else parse value arg(1) with figs type armds limps owc .

/* deployment macro */
dmac=""
if armds>0 then dmac=dmac||"h1z"||armds||"^Mzczn"
if limps>0 then dmac=dmac||"h2z"||limps||"^Mzczn"
dmac=dmac||"fz"||figs||"^Mzc"||type||"zn"

/* get sector info */
base=_getinfo("sect")
adjlist=_getwarps()

/* clear adjacent voids */
call zocsend "^^c"||base||"^M"
do i=1 to _dwords(adjlist,";")
 sec=_dword(adjlist,i,";")
 call zocsend "c"||sec||"^M"
end /*do*/
call zocsend "q"
if zocwait("ENDINTERROG")=640 then call _error "timeout"

list=""
do i=1 to _dwords(adjlist,";")
 sec=_dword(adjlist,i,";")
 if sec>10 then list=list||";"||sec
end /*do*/
adjlist=list

/* oneway check */
if owc then do
 list=""
 do i=1 to _dwords(adjlist,";")
  sec=_dword(adjlist,i,";")
  if _distance(sec,base)=1 then list=list||" "||sec
 end /*do*/
end /*if*/
else list=translate(adjlist," ",";")

/* build macro */
macro="cunq"
do i=1 to words(list)
 macro=macro||"m"||word(list,i)||"^Mza999^Mzn"||dmac||"<zn"
end /*do*/
macro=macro||"cuyq"
macro=zocstring("replace",macro,"^M",d2c(13))
macro=zocstring("replace",macro,"^m",d2c(13))

call zocsendraw macro

exit

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _halt v.3 **/
    _halt: procedure expose (globals)
     call off halt
     call zocwriteln "^[[1;33m< user abort >^[[0m "
     exit
    return

/** _pcheck v.4 **/
    _pcheck: procedure expose (globals)
     pc1=arg(1)
     pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     rslt=0
     do i=1 to _dwords(pc1,";")
      if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1
     end /*do*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _askint v.2 **/
    _askint: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an integer:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripint(rslt)\=rslt | rslt=""
      default=rslt||" [please enter an integer or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _chooselist v.6 **/
    _chooselist: procedure expose (globals)
     prompt=arg(1)
     list=arg(2)
     if list="" then call _error "no list"
     delim=arg(3)
     if delim="" then delim=" "
     if length(delim)>1 then call _error "long delimiter"
    
     ch.=""
     i=_dwords(list,delim)
     do j=1 to i
      ch.j=_dword(list,j,delim)
     end /*do*/
    
     if i<7 then max=1
     if i<5 then max=0
     if i>=7 then max=(i-5)%2+1
    
     done=0
     loc=0
     do while \done
      if loc<0 then loc=0
      if loc>max then loc=max
    
      select
       when loc=0 then do
        if max=0 then rslt=zocrequest(prompt, ch.1, ch.2, ch.3, ch.4)
        else rslt=zocrequest(prompt, ch.1, ch.2, ch.3, "next")
       end /*when*/
       when loc=max then do
        p1=(loc-1)*2+4
        p2=p1+1
        p3=p1+2
        rslt=zocrequest(prompt, "back", ch.p1, ch.p2, ch.p3)
       end /*when*/
       otherwise do
        p1=(loc-1)*2+4
        p2=p1+1
        rslt=zocrequest(prompt, "back", ch.p1, ch.p2, "next")
       end /*otherwise*/
      end /*select*/
    
      select
       when rslt="next" then loc=loc+1
       when rslt="back" then loc=loc-1
       when rslt="##CANCEL##" then done=1
       when rslt="" then nop
       otherwise done=1
      end /*select*/
    
     end /*do*/
    
     if lower(arg(4))="c" & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    
    return rslt

/** _getinfo v.5 **/
    _getinfo: procedure expose (globals)
     args=lower(arg(1))
     bufflen=3*1024
     call zocreceivebuf bufflen
     call zocsend "/"
     if zocwait("Sect ")=640 then call _error "timeout"
     if zocwait("Ship ")=640 then call _error "timeout"
     if zocwait("^M")=640 then call _error "timeout"
     buff=translate(zocreceivebuf(0),"  ",d2c(10)||d2c(0))
     if length(buff)>=bufflen then call zocwrite "<buffer overflow>"
     i=pos("Sect ",buff)
     j=pos("Ship",buff,i)
     j=pos(d2c(13),buff,j)
     buff=substr(buff,i,j-i)
     buff=_space(translate(buff, "  ;;", d2c(0)||d2c(10)||d2c(13)||d2c(179)),1)
     buff=translate(_space(translate(buff,", "," ,"),0),", "," ,")
    
     vr.=""
     vl.=""
     c=0
     do j=1 to _dwords(buff,";")
      c=c+1
      vr.c=strip(_dword(buff,j,";"))
      vl.c=word(vr.c,2)
      vr.c=lower(word(vr.c,1))
      if vr.c="ship" then do
       c=c+1
       vr.c=strip(_dword(buff,j,";"))
       vl.c=word(vr.c,3)
       vr.c="shiptype"
      end /*if*/
     end /*do*/
    
     rslt=""
     do i=1 to _dwords(args,";")
      found=0
      do j=1 to c
       if vr.j=_dword(args,i,";") then do
        rslt=rslt||";"||vl.j
        found=1
       end /*if*/
      end /*do*/
      if \found then rslt=rslt||";"||"##NA##"
     end /*do*/
     if rslt\="" then rslt=substr(rslt,2)
    
    return rslt

/** _getwarps v.5 **/
    _getwarps: procedure expose (globals)
     if _s.1="_S.1" then _s.=""
     sec=arg(1)
     call zocreceivebuf 1024*3
     call zocsend "ci"||sec||"^Mq"
     if zocwait("<Computer deactivated>")=640 then call _error "timeout"
     if zocwaitmux("Command [", "Citadel command")=640 then call _error "timeout"
     buff=translate(zocreceivebuf(0),"  ",d2c(10)||d2c(0))
     if sec="" then do
      i=pos("What sector do you wish to examine? [",buff)+37
      j=pos("]",buff,i)
      if i>0 & j>0 then sec=substr(buff,i,j-i)
     end /*if*/
     i=pos("warps to sector(s) :",buff)+20
     j=pos(d2c(13),buff,i)
     if i>20 & j>0 then rslt=_space(translate(substr(buff,i,j-i),"   ","-()"),1,";")
     else rslt=""
     if sec\="" & rslt\="" & _s.sec="" then _s.sec=rslt
    return rslt

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _distance v.3 **/
    _distance: procedure expose (globals)
     start=arg(1)
     finish=arg(2)
     mapname=arg(3)
     reclen=arg(4)
     if _dist.1.1="_DIST.1.1" then _dist.=255
     if _dist.start.finish=255 then do
      if mapname="" | reclen="" then do
       bufflen=2*1024
       call zocreceivebuf bufflen
       call zocsend "^^f"||start||"^M"||finish||"^Mq"
       if zocwait("ENDINTERROG")=640 then call _error "timeout"
       buff=translate(zocreceivebuf(0),"  ",d2c(0)||d2c(10))
       if length(buff)=bufflen then call _error "buffer overflow"
       i=pos("FM > "||start,buff)
       if i>0 then i=pos("TO > "||finish,buff,i)
       if i>0 then i=pos(d2c(13),buff,i)+1
       if i>1 then j=pos(d2c(13),buff,i)
       course=""
       do while i>1 & j>0
        line=_space(translate(substr(buff,i,j-i),"  ;","()>"),0)
        if line="" then leave
        course=course||line
        i=j+1
        j=pos(d2c(13),buff,i)
       end /*do*/
    
       _dist.start.finish=_dwords(course,";")-1
       _path.start.finish=course
    
       if _dist.start.finish>1 then do
        nw=_dwords(course,";")
        do i=1 to (nw-1)
         do j=(i+1) to nw
          ts=_dword(course,i,";")
          tf=_dword(course,j,";")
          if _dist.ts.tf=255 then _dist.ts.tf=j-i
         end /*do*/
        end /*do*/
       end /*if*/
    
      end /*if*/
      else call _mapdist start, finish, mapname, reclen, arg(5), arg(6)
     end /*if*/
    
     rslt=_dist.start.finish
      
    return rslt

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _instr v.3 **/
    _instr: procedure expose (globals)
     fnd=arg(1)
     str=arg(2)
     if lower(arg(3))\="cs" then do
      fnd=lower(fnd)
      str=lower(str)
     end /*if*/
     if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1
     else rslt=0
    return rslt

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _stripint v.4 **/
    _stripint: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789"," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if \datatype(rslt,"W") then rslt=""
    return rslt

/** _mapdist v.2 **/
    _mapdist: procedure expose (globals)
     start=arg(1)
     finish=arg(2)
     mapname=arg(3)
     reclen=arg(4)
     reverse=arg(5)
     if reverse="" then reverse=0
     maxdist=arg(6)
     if maxdist="" | maxdist<1 then maxdist=255
    
     call _mapseek mapname, reclen, start
     _dist.start.start=0
     _path.start.start=start
    
     /* initialize arrays */
     inqueue.=0
     queue.=""
     queue.1=start
     inqueue.start=1
     tail=1
     do i=1 to _dwords(_s.start,";")
      code=_dword(_s.start,i,";")
      warptype=code%20000
      sector=code//20000
      if (warptype<2 & \reverse) | (warptype>0 & reverse) then do
       tail=tail+1
       queue.tail=sector
       inqueue.sector=1
      end /*if*/
     end /*do*/
     head=2
    
     if _verbose then do
      if \reverse then call zocwrite _ansi("bt;fye")||"searching "||start||"->"||finish||".."
                  else call zocwrite _ansi("bt;fye")||"searching "||finish||"->"||start||".."
      mon=_spinner(0,500,".oOo.")
     end /*if*/
    
     done=0
     do while \done & tail>=head
    
      current=queue.head
      call _mapseek mapname, reclen, current
    
      do i=1 to _dwords(_s.current,";")
    
       if _verbose then mon=_spinner(mon,100,".oOo.")
       code=_dword(_s.current,i,";")
       warptype=code%20000
       adjacent=code//20000
    
       /* if adjacent not in queue, then add to tail */
       if ((warptype<2 & \reverse) | (warptype>0 & reverse)) & \inqueue.adjacent then do
        tail=tail+1
        queue.tail=adjacent
        inqueue.adjacent=1
       end /*if*/
    
       /* assign shortest warp distance */
       if warptype>0 & \reverse then do
        tdist=_dist.start.current
        _dist.start.current=min(_dist.start.current,_dist.start.adjacent+1)
        if tdist>_dist.start.current then _path.start.current=_path.start.adjacent||";"||current
       end /*if*/
    
       if warptype<2 & reverse then do
        tdist=_dist.current.start
        _dist.current.start=min(_dist.current.start,_dist.adjacent.start+1)
        if tdist>_dist.current.start then _path.current.start=current||";"||_path.adjacent.start
       end /*if*/
    
      end /*do*/
    
      /* have we found the destination? */
      select
       when current=finish then done=1
       when _dist.start.current>maxdist & \reverse then done=1
       when _dist.current.start>maxdist & reverse then done=1
       when head=tail then done=1
       otherwise head=head+1
      end /*select*/
    
     end /*do*/
     if _verbose then mon=_spinner(-1,500,".oOo.")
     if _verbose then call zocwriteln
    
    return _dist.start.finish

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt

/** _mapseek v.3 **/
    _mapseek: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") | \arg(3,"E") then call _error "missing parameter in _mapseek"
     fname=arg(1)
     reclen=arg(2)
     sector=arg(3)
    
     if _s.sector="_S."||sector | _s.sector="" then do
    
      call stream fname, "C", "SEEK "||(sector-1)*reclen+2
     
      vis=0
      one=0
      prt=0
      pvis=0
      bore=0
      borg=0
      bequ=0
      flags=c2d(charin(fname))
      if flags%128=1 then do
       bequ=1
       flags=flags-128
      end /*if*/
      if flags%64=1 then do
       borg=1
       flags=flags-64
      end /*if*/
      if flags%32=1 then do
       bore=1
       flags=flags-32
      end /*if*/
      if flags%16=1 then do
       _pv.sector=1
       flags=flags-16
      end /*if*/
      if flags%8=1 then do
       prt=1
       flags=flags-8
      end /*if*/
      if flags%4=1 then flags=flags-4
      if flags%2=1 then do
       _od.sector=1
       flags=flags-2
      end /*if*/
      if flags%1=1 then do
       _sv.sector=1
       flags=flags-1
      end /*if*/
     
      if prt then do
       if bore then _p.sector="B"
       else _p.sector="S"
       if borg then _p.sector=_p.sector||"B"
       else _p.sector=_p.sector||"S"
       if bequ then _p.sector=_p.sector||"B"
       else _p.sector=_p.sector||"S"
       do i=1 to 3
        ms1=charin(fname)
        ms2=charin(fname)
        ms3=charin(fname)
        _p.sector=_p.sector||";"c2d(ms1)+c2d(ms2)*256||","||c2d(ms3)
       end /*do*/
      end /*if*/
      else do
       _p.sector=""
       call stream fname, "C", "SEEK "||1+(sector-1)*reclen+11
      end /*else*/
      _dtomsl.sector=c2d(charin(fname))
      _dfrmsl.sector=c2d(charin(fname))
      _bg.sector=c2d(charin(fname))+c2d(charin(fname))*256
      _nwi.sector=c2d(charin(fname))
    
      ms1=c2d(charin(fname))+c2d(charin(fname))*256
      if ms1=0 then _s.sector=""
      else do
       _s.sector=ms1
       do i=1 to ((reclen-15)%2-1)
        ms1=c2d(charin(fname))+c2d(charin(fname))*256
        if ms1>0 then _s.sector=_s.sector||";"||ms1
       end /*do*/
      end /*else*/
    
     end /*if*/
    return

/** _spinner v.3 **/
    _spinner: procedure expose (globals)
     if arg(1,"E") then count=arg(1)
                   else call _error "missing parameter in _spinner"
     if arg(2,"E") then width=arg(2)
                   else width=100
     if arg(3,"E") & length(arg(3))=5 then chs=arg(3)
                                      else chs="-\|/."
    /* bs="^H" */
     bs=d2c(27)||"[1D"
     select
      when count=-1        then call zocwrite bs||substr(chs,5,1)
      when count<0         then count=-1
      when count=0         then call zocwrite left(chs,1)
      when count=width     then call zocwrite bs||substr(chs,2,1)
      when count=(width*2) then call zocwrite bs||substr(chs,3,1)
      when count=(width*3) then call zocwrite bs||substr(chs,4,1)
      when count=(width*4) then do
       call zocwrite bs||left(chs,1)
       count=0
      end /*when*/
      otherwise nop
     end /*select*/
     count=count+1
    return count